;;;
;;; tag_fuse.scm - tag filesystem
;;;
;;;   Copyright (c) 2008 Teruaki Gemma <teruakigemma@gmail.com>
;;;
;;;   Redistribution and use in source and binary forms, with or without
;;;   modification, are permitted provided that the following conditions
;;;   are met:
;;;
;;;   1. Redistributions of source code must retain the above copyright
;;;      notice, this list of conditions and the following disclaimer.
;;;
;;;   2. Redistributions in binary form must reproduce the above copyright
;;;      notice, this list of conditions and the following disclaimer in the
;;;      documentation and/or other materials provided with the distribution.
;;;
;;;   3. Neither the name of the authors nor the names of its contributors
;;;      may be used to endorse or promote products derived from this
;;;      software without specific prior written permission.
;;;
;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;;  $Id$
;;;

(use srfi-1)
(use file.util)
(use util.combinations)
(use gauche.uvector)
(use fuse)

(define tags (list "artist" "track" "album" "Alice" "Bob" "good" "happy" "hacking"))

(define (tag-path2real-path path)
  (let1 path (if (member (sys-basename path) tags)
	       (string-append path "/")
	       path)
    (receive (dir fn ext) (decompose-path path)
      (string-join (append
		    (list "./tagfs")
		    (sort (remove (cut string=? <> "")
				  (string-split dir "/")))
		    (cond
		     ((and fn ext) (list (string-append fn "." ext)))
		     (fn (list fn))
		     (else '())))
		   "/"))))

(define (copy-port-block src dest size)
  (define vec (make-u8vector size))
  (let1 r (read-block! vec src)
    (and (not (eof-object? r))
	 (write-block vec dest)
	 r)))

(define (my-readdir path file-info)
  (receive (dirs files) (directory-list2 (tag-path2real-path path))
    (append (lset-difference string=? tags (string-split path "/"))
	    files)))

(define (my-mknod path mode rdev)
  (define st (make <sys-stat>))
  (sys-stat->mode-set! st mode)
  (case (slot-ref st 'type)
    ('regular
     (close-output-port (open-output-file (tag-path2real-path path))))
    ('fifo
     (sys-mkfifo (tag-path2real-path path) mode))
    (else
     ;;please use the "mknod" external command.
     (error <system-error> :errno ENOENT))))

(define (my-open path file-info)
  (close-input-port (open-input-file (tag-path2real-path path))))

(define (my-read path outp size offset file-info)
  (call-with-input-file (tag-path2real-path path)
    (lambda (in)
      (port-seek in offset)
      (copy-port-block in outp size))))

(define (my-write path inp size offset file-info)
  (call-with-output-file  (tag-path2real-path path)
    (lambda (out)
      (port-seek out offset)
      (copy-port-block inp out size))
    :if-exists :overwrite))

(define (my-getattr path)
  (sys-lstat (tag-path2real-path path)))

(define (my-access path mode)
  (sys-access (tag-path2real-path path) mode))

(define (my-unlink path)
  (sys-unlink (tag-path2real-path path)))

(define (my-chmod path mode)
  (sys-chmod (tag-path2real-path path) mode))

(define (my-chown path uid gid)
  (sys-chown (tag-path2real-path path) uid gid))

(define (my-truncate path length)
  (sys-truncate (tag-path2real-path path) length))

(define (my-utime path atime mtime)
  (sys-utime (tag-path2real-path path) atime mtime))

(define (main args)
  (for-each (lambda (l)
	      (make-directory* (tag-path2real-path (string-join l "/")) #o755))
	    (power-set tags))
  ;;TODO support "mkdir" to create new tags.
  (start-fuse (car (last-pair args))
	      :args args
	      :multithreaded #f
	      :getattr  my-getattr
	      :access   my-access
	      ;;:readlink sys-readlink
	      ;;:mkdir    sys-mkdir
	      ;;:symlink  sys-symlink
	      :unlink   my-unlink
	      ;;:rmdir    sys-rmdir
	      ;;:rename   sys-rename
	      ;;:link     sys-link
	      :chmod    my-chmod
	      :chown    my-chown
	      :truncate my-truncate
	      :utimens  my-utime
	      ;;:statfs   sys-statvfs
	      :readdir  my-readdir
	      :mknod    my-mknod
	      :open     my-open
	      :read     my-read
	      :write    my-write))

